home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / program / xmsbcp11.zip / PASCAL / XMS.PAS < prev    next >
Pascal/Delphi Source File  |  1997-04-13  |  13KB  |  577 lines
  1.  
  2. {-----------------------------------------------------------------------}
  3. {                                    }
  4. {    XMS Interface Unit for Borland Pascal 7.0, Version 1.1        }
  5. {    Developed by Tanescu A. Horatiu                    }
  6. {    April 1997                            }
  7. {                                    }
  8. {-----------------------------------------------------------------------}
  9.  
  10. unit XMS;
  11.  
  12.  
  13. interface
  14.  
  15.  
  16. { XMS error codes }
  17.  
  18. const XE_NOERROR        = $00; { no error, successful operation }
  19.  
  20. { miscellaneous errors }
  21. const XE_NOTIMPLEMENTED        = $80; { the function is not implemented }
  22. const XE_API            = XE_NOTIMPLEMENTED;
  23. const XE_VDISK            = $81; { a VDISK device is detected }
  24. const XE_A20            = $82; { an A20 error occurs }
  25. const XE_DRVFAULT        = $8E; { a general driver error occurs }
  26. const XE_UNRECOVERABLE        = $8F; { an unrecoverable driver error occurs }
  27.  
  28. { HMA errors }
  29. const XE_NO_HMA            = $90; { the HMA does not exist }
  30. const XE_NO_FREEHMA        = $91; { the HMA is already in use }
  31. const XE_BAD_HMAMINSIZE        = $92; { DX is less than the /HMAMIN= parameter }
  32. const XE_HMANOTALLOCATED    = $93; { the HMA is not allocated }
  33. const XE_A20ENABLED        = $94; { the A20 line is still enabled }
  34.  
  35. { eXtended Memory errors }
  36. const XE_NO_FREEMEM        = $A0; { all extended memory is allocated }
  37. const XE_NO_FREEHANDLES        = $A1; { all available extended memory handles are in use }
  38. const XE_BAD_HANDLE         = $A2; { the handle is invalid }
  39. const XE_BAD_SRC_HANDLE        = $A3; { the SourceHandle is invalid }
  40. const XE_BAD_SRC_OFF        = $A4; { the SourceOffset is invalid }
  41. const XE_BAD_DEST_HANDLE    = $A5; { the DestHandle is invalid }
  42. const XE_BAD_DEST_OFF        = $A6; { the DestOffset is invalid }
  43. const XE_BAD_LEN        = $A7; { the Length is invalid }
  44. const XE_BAD_OVERLAP        = $A8; { the move has an invalid overlap }
  45. const XE_PARITY            = $A9; { a parity error occurs }
  46. const XE_UNLOCKED        = $AA; { the block is not locked }
  47. const XE_LOCKED            = $AB; { the block is locked }
  48. const XE_LOCKCOUNTOF        = $AC; { the block's lock count overflows }
  49. const XE_LOCKFAIL        = $AD; { the lock fails }
  50.  
  51. { UMB errors }
  52. const XE_UMB2BIG        = $B0; { a smaller UMB is available }
  53. const XE_NO_UMBS        = $B1; { no UMBs are available }
  54. const XE_BAD_UMBSEG        = $B2; { the UMB segment number is invalid }
  55.  
  56. { Miscellaneous constants }
  57.  
  58. const HMASEG            = $FFFF;
  59. const HMASTARTOFF        = $0010;
  60. const HMAENDOFF            = $FFFF;
  61.  
  62. { 16-bit handle to an extended memory block }
  63.  
  64. type
  65.   XMHandle = Word;
  66.  
  67. { Record used by memory transfer routines }
  68.  
  69. type
  70.  TXMCopyRec = record
  71.    Count        : Longint;
  72.    SourceHandle : XMHandle;
  73.    SourceOff    : Longint;
  74.    DestHandle   : XMHandle;
  75.    DestOff      : Longint;
  76.  end;
  77.  
  78. { Error status variable }
  79.  
  80. var
  81.   XMSError : Byte;
  82.  
  83. { Indicates the existance of an XMS driver }
  84.  
  85. var
  86.   XMSInstalled : Boolean;
  87.  
  88. { Initialization Functions }
  89.  
  90. function  XMSDriverCheck : Boolean;
  91. procedure GetXMSFunct;
  92. procedure InitXMS;
  93.  
  94. { Driver Information Functions }
  95.  
  96. function  XMSVersion : Word;
  97. function  XMSVersionInfo(var Revision : Word; var HMA : Boolean) : Word;
  98.  
  99. { High Memory Area (HMA) Management Functions }
  100.  
  101. function  HMARequest(ReqSize : Word) : Boolean;
  102. function  HMARelease : Boolean;
  103.  
  104. { A20 Management Functions }
  105.  
  106. function  GlobalEnableA20 : Boolean;
  107. function  GlobalDisableA20 : Boolean;
  108. function  LocalEnableA20 : Boolean;
  109. function  LocalDisableA20 : Boolean;
  110. function  QueryA20 : Boolean;
  111.  
  112. { eXtended Memory Management Functions }
  113.  
  114. function  XMFreeSpace : Word;
  115. function  XMContig : Word;
  116. function  XMAlloc(Size : Word) : XMHandle;
  117. function  XMFree(Handle : XMHandle) : Boolean;
  118. function  XMLock(Handle : XMHandle) : Longint;
  119. function  XMUnlock(Handle : XMHandle) : Boolean;
  120. function  XMHandleInfo(Handle : XMHandle; var Size : Word; var LockCount,
  121.                       FreeHandles : Byte) : Boolean;
  122. function  XMRealloc(Handle : XMHandle; NewSize : Word) : Boolean;
  123.  
  124. { eXtended Memory Transfer Functions }
  125.  
  126. function  XMemCopy(const CopyRec : TXMCopyRec) : Boolean;
  127. function _XMemCopy(N : Longint; SrcHandle : XMHandle; SrcOff : Longint;
  128.                    DestHandle : XMHandle; DestOff : Longint) : Boolean;
  129. function  CopyCMemToXMem(DestHandle : XMHandle; DestOff : Longint;
  130.                          Src : Pointer; N : Longint) : Boolean;
  131. function  CopyXMemToCMem(Dest : Pointer; SrcHandle : XMHandle;
  132.                          SrcOff : Longint; N : Longint) : Boolean;
  133. function  CopyXMem(DestHandle : XMHandle; DestOff : Longint;
  134.                    SrcHandle : XMHandle; SrcOff : Longint; N : Longint) : Boolean;
  135. function  CopyMem(Dest : Pointer; Src : Pointer; N : Longint) : Boolean;
  136.  
  137. { Upper Memory Blocks (UMB) Management Functions }
  138.  
  139. function  UMBAlloc(var Size : Word) : Word;
  140. function  UMBFree(UMBSeg : Word) : Boolean;
  141. function  UMBReAlloc(UMBSeg : Word; var Size : Word) : Boolean;
  142.  
  143. { XMS error functions }
  144.  
  145. function  XMSErrorMsg(ErrorCode : Byte) : PChar;
  146. procedure PrintXMSError(const S : string);
  147.  
  148. implementation
  149.  
  150. const
  151.   XMSErrorCount = 27;
  152.  
  153.   XMSErrorNumber : array [1..XMSErrorCount] of Byte =
  154.   ($80, $81, $82, $8E, $8F, $90, $91, $92, $93, $94, $A0, $A1, $A2, $A3, $A4,
  155.    $A5, $A6, $A7, $A8, $A9, $AA, $AB, $AC, $AD, $B0, $B1, $B2);
  156.  
  157.   XMSErrorString: array [0..XMSErrorCount] of PChar = (
  158. { 00h }        'Unknown error',
  159. { 80h }        'Function not implemented',
  160. { 81h }        'VDISK device detected',
  161. { 82h }        'An A20 error occurred',
  162. { 8Eh }        'A general driver error occurred',
  163. { 8Fh }        'An unrecoverable driver error occurred',
  164. { 90h }        'The HMA does not exist',
  165. { 91h }        'The HMA is already in use',
  166. { 92h }        'DX is less than the /HMAMIN= parameter',
  167. { 93h }        'The HMA is not allocated',
  168. { 94h }        'The A20 line is still enabled',
  169. { A0h }        'All extended memory is allocated',
  170. { A1h }        'All available extended memory handles are in use',
  171. { A2h }        'Invalid handle',
  172. { A3h }        'Invalid SourceHandle',
  173. { A4h }        'Invalid SourceOffset',
  174. { A5h }        'Invalid DestHandle',
  175. { A6h }        'Invalid DestOffset',
  176. { A7h }        'Invalid length',
  177. { A8h }        'The move has an invalid overlap',
  178. { A9h }        'A parity error occurred',
  179. { AAh }        'The block is not locked',
  180. { ABh }        'The block is locked',
  181. { ACh }        'Block lock count overflow',
  182. { ADh }        'Lock failure',
  183. { B0h }        'A smaller UMB is available',
  184. { B1h }        'No UMBs are available',
  185. { B2h }        'Invalid UMB segment number');
  186.  
  187. { Adress of the XMS driver control function }
  188.  
  189. var
  190.   XMSControl : Pointer;
  191.  
  192. procedure XMSDefaultControl; far; assembler;
  193. asm
  194.     XOR    AX, AX
  195.     MOV    BL, 80h
  196.     MOV    XMSError, BL
  197. end;
  198.  
  199. function XMSDriverCheck : Boolean; assembler;
  200. asm
  201.     MOV    AX, 4300h
  202.     INT    2Fh
  203.     SUB    AL, 80h
  204.     NOT    AL
  205. end;
  206.  
  207. procedure GetXMSFunct; assembler;
  208. asm
  209.     MOV    AX, 4310h
  210.     INT    2Fh
  211.     MOV    WORD PTR [XMSControl], BX
  212.     MOV    WORD PTR [XMSControl+2], ES
  213. end;
  214.  
  215. procedure InitXMS;
  216. begin
  217.   XMSInstalled := XMSDriverCheck;
  218.   if XMSInstalled then GetXmsFunct;
  219. end;
  220.  
  221. function XMSVersionInfo(var revision : Word; var HMA : Boolean) : Word; assembler;
  222. asm
  223.     XOR    AH, AH
  224.     CALL    [XMSControl]
  225.     MOV    CX, AX
  226.     MOV    AX, BX
  227.     LES    DI, revision
  228.     STOSW
  229.     MOV    AL, DL
  230.     LES    DI, HMA
  231.     STOSB
  232.     MOV    AX, CX
  233. end;
  234.  
  235. function XMSVersion : Word; assembler;
  236. asm
  237.     XOR    AH, AH
  238.     CALL    [XMSControl]
  239. end;
  240.  
  241. function HMARequest(ReqSize : Word) : Boolean; assembler;
  242. asm
  243.     MOV    DX, ReqSize
  244.     XOR    BL, BL
  245.     MOV    AH, 01h
  246.     CALL    [XMSControl]
  247.     MOV    XMSError, BL
  248. end;
  249.  
  250. function HMARelease : Boolean; assembler;
  251. asm
  252.     XOR    BL, BL
  253.     MOV    AH, 02h
  254.     CALL    [XMSControl]
  255.     MOV    XMSError, BL
  256. end;
  257.  
  258. function GlobalEnableA20 : Boolean; assembler;
  259. asm
  260.     XOR    BL, BL
  261.     MOV    AH, 03h
  262.     CALL    [XMSControl]
  263.     MOV    XMSError, BL
  264. end;
  265.  
  266. function GlobalDisableA20 : Boolean; assembler;
  267. asm
  268.     XOR    BL, BL
  269.     MOV    AH, 04h
  270.     CALL    [XMSControl]
  271.     MOV    XMSError, BL
  272. end;
  273.  
  274. function LocalEnableA20 : Boolean; assembler;
  275. asm
  276.     XOR    BL, BL
  277.     MOV    AH, 05h
  278.     CALL    [XMSControl]
  279.     MOV    XMSError, BL
  280. end;
  281.  
  282. function LocalDisableA20 : Boolean; assembler;
  283. asm
  284.     XOR    BL, BL
  285.     MOV    AH, 06h
  286.     CALL    [XMSControl]
  287.     MOV    XMSError, BL
  288. end;
  289.  
  290. function QueryA20 : Boolean; assembler;
  291. asm
  292.     XOR    BL, BL
  293.     MOV    AH, 07h
  294.     CALL    [XMSControl]
  295.     MOV    XMSError, BL
  296. end;
  297.  
  298. function XMFreeSpace : Word; assembler;
  299. asm
  300.     XOR    BL, BL
  301.     MOV    AH, 08h
  302.     CALL    [XMSControl]
  303.     MOV    XMSError, BL
  304.     MOV    AX, DX
  305. end;
  306.  
  307. function XMContig : Word; assembler;
  308. asm
  309.     XOR    BL, BL
  310.     MOV    AH, 08h
  311.     CALL    [XMSControl]
  312.     MOV    XMSError, BL
  313. end;
  314.  
  315. function XMAlloc(Size : Word) : XMHandle; assembler;
  316. label
  317.   AllocFailed;
  318. asm
  319.     MOV    DX, Size
  320.     XOR    BL, BL
  321.     MOV    AH, 09h
  322.     CALL    [XMSControl]
  323.     MOV    XMSError, BL
  324.     OR    AX, AX
  325.     JE    AllocFailed
  326.     MOV    AX, DX
  327. AllocFailed:
  328. end;
  329.  
  330. function XMFree(Handle : XMHandle) : Boolean; assembler;
  331. asm
  332.     MOV    DX, Handle
  333.     XOR    BL, BL
  334.     MOV    AH, 0Ah
  335.     CALL    [XMSControl]
  336.     MOV    XMSError, BL
  337. end;
  338.  
  339. function XMLock(Handle : XMHandle) : Longint; assembler;
  340. label
  341.   LockFailed;
  342. asm
  343.     MOV    DX, Handle
  344.     XOR    BL, BL
  345.     MOV    AH, 0Ch
  346.     CALL    [XMSControl]
  347.     MOV    XMSError, BL
  348.     OR    AX, AX
  349.     JE    LockFailed
  350.     MOV    AX, BX
  351.     RET
  352. LockFailed:
  353.     XOR    DX, DX
  354. end;
  355.  
  356. function XMUnlock(Handle : XMHandle) : Boolean; assembler;
  357. asm
  358.     MOV    DX, Handle
  359.     XOR    BL, BL
  360.     MOV    AH, 0Dh
  361.     CALL    [XMSControl]
  362.     MOV    XMSError, BL
  363. end;
  364.  
  365. function XMHandleInfo(Handle : XMHandle; var Size : Word; var LockCount,
  366.                       FreeHandles : Byte) : Boolean; assembler;
  367. label
  368.   InvalidHandle;
  369. asm
  370.     MOV    DX, Handle
  371.     XOR    BL, BL
  372.     MOV    AH, 0Eh
  373.     CALL    [XMSControl]
  374.     OR    AX, AX
  375.     JE      InvalidHandle
  376.     MOV    AX, DX
  377.     LES    DI, Size
  378.     STOSW
  379.     MOV    AL, BH
  380.     LES    DI, LockCount
  381.     STOSB
  382.     MOV    AL, BL
  383.     LES    DI, FreeHandles
  384.     STOSB
  385.     MOV    XMSError, 0
  386.     MOV    AL, 1
  387.     RET
  388. InvalidHandle:
  389.     MOV    XMSError, BL
  390. end;
  391.  
  392. function XMRealloc(Handle : XMHandle; NewSize : Word) : Boolean; assembler;
  393. asm
  394.     MOV    BX, NewSize
  395.     MOV    DX, Handle
  396.     XOR    BL, BL
  397.     MOV    AH, 0Fh
  398.     CALL    [XMSControl]
  399.     MOV    XMSError, BL
  400. end;
  401.  
  402. function XMemCopy(const CopyRec : TXMCopyRec) : Boolean;
  403. var
  404.   RSeg, ROfs : Word;
  405. begin
  406.   RSeg := Seg(CopyRec);
  407.   ROfs := Ofs(CopyRec);
  408.  
  409.     asm
  410.     PUSH    DS
  411.     MOV    AX, DS
  412.     MOV    ES, AX
  413.     MOV    SI, ROfs
  414.     MOV    AX, RSeg
  415.         MOV    DS, AX
  416.     XOR    BL, BL
  417.     MOV    AH, 0Bh
  418.     CALL    [ES:XMSControl]
  419.         POP    DS
  420.     MOV    XMSError, BL
  421.     end;
  422.  
  423. end;
  424.  
  425. function _XMemCopy(N : Longint; SrcHandle : XMHandle; SrcOff : Longint;
  426.                    DestHandle : XMHandle; DestOff : Longint) : Boolean;
  427. var
  428.   X : TXMCopyRec;
  429.   RSeg, ROfs : Word;
  430. begin
  431.   X.Count        := N;
  432.   X.SourceHandle := SrcHandle;
  433.   X.SourceOff    := SrcOff;
  434.   X.DestHandle   := DestHandle;
  435.   X.DestOff      := DestOff;
  436.   RSeg := Seg(X);
  437.   ROfs := Ofs(X);
  438.  
  439.     asm
  440.     PUSH    DS
  441.     MOV    AX, DS
  442.     MOV    ES, AX
  443.     MOV    SI, ROfs
  444.     MOV    AX, RSeg
  445.         MOV    DS, AX
  446.     XOR    BL, BL
  447.     MOV    AH, 0Bh
  448.     CALL    [ES:XMSControl]
  449.         POP    DS
  450.     MOV    XMSError, BL
  451.     end;
  452.  
  453. end;
  454.  
  455. function CopyCMemToXMem(DestHandle : XMHandle; DestOff : Longint;
  456.                         Src : Pointer; N : Longint) : Boolean;
  457. var
  458.   X : TXMCopyRec;
  459. begin
  460.   X.Count        := N;
  461.   X.SourceHandle := 0;
  462.   X.SourceOff    := Longint(Src);
  463.   X.DestHandle   := DestHandle;
  464.   X.DestOff      := DestOff;
  465.   CopyCMemToXMem := XMemCopy(X);
  466. end;
  467.  
  468. function CopyXMemToCMem(Dest : Pointer; SrcHandle : XMHandle;
  469.             SrcOff : Longint; N : Longint) : Boolean;
  470. var
  471.   X : TXMCopyRec;
  472. begin
  473.   X.Count        := N;
  474.   X.SourceHandle := SrcHandle;
  475.   X.SourceOff    := SrcOff;
  476.   X.DestHandle   := 0;
  477.   X.DestOff      := Longint(Dest);
  478.   CopyXMemToCMem := XMemCopy(X);
  479. end;
  480.  
  481. function CopyXMem(DestHandle : XMHandle; DestOff : Longint;
  482.                   SrcHandle : XMHandle; SrcOff : Longint; N : Longint) : Boolean;
  483. var
  484.   X : TXMCopyRec;
  485. begin
  486.   X.Count        := N;
  487.   X.SourceHandle := SrcHandle;
  488.   X.SourceOff    := SrcOff;
  489.   X.DestHandle   := DestHandle;
  490.   X.DestOff      := DestOff;
  491.   CopyXMem       := XMemCopy(X);
  492. end;
  493.  
  494. function CopyMem(Dest : Pointer; Src : Pointer; N : Longint) : Boolean;
  495. var
  496.   X : TXMCopyRec;
  497. begin
  498.   X.Count        := N;
  499.   X.SourceHandle := 0;
  500.   X.SourceOff    := Longint(Src);
  501.   X.DestHandle   := 0;
  502.   X.DestOff      := Longint(Dest);
  503.   CopyMem        := XMemCopy(X);
  504. end;
  505.  
  506. function UMBAlloc(var Size : Word) : Word; assembler;
  507. label
  508.   UMBAllocFailed;
  509. asm
  510.     LES    DI, Size
  511.     LODSW
  512.     MOV    DX, AX
  513.     XOR    BL, BL
  514.     MOV    AH, 10h
  515.     CALL    [XMSControl]
  516.     MOV    AX, DX
  517.     LES    DI, Size
  518.     STOSW
  519.     OR    AX, AX
  520.     JE    UMBAllocFailed
  521.     MOV    XMSError, 0
  522.         MOV    AX, BX
  523.     RET
  524. UMBAllocFailed:
  525.     MOV    XMSError, BL
  526. end;
  527.  
  528. function UMBFree(UMBSeg : Word) : Boolean; assembler;
  529. asm
  530.     MOV    DX, UMBSeg
  531.     XOR    BL, BL
  532.     MOV    AH, 11h
  533.     CALL    [XMSControl]
  534.     MOV    XMSError, BL
  535. end;
  536.  
  537. function UMBReAlloc(UMBSeg : Word; var Size : Word) : Boolean; assembler;
  538. label
  539.   UMBReAllocFailed;
  540. asm
  541.     LES    DI, Size
  542.     LODSW
  543.     MOV    BX, AX
  544.     MOV    DX, UMBSeg
  545.     MOV    AH, 12h
  546.     CALL    [XMSControl]
  547.     OR    AX, AX
  548.     JE    UMBReAllocFailed
  549.     MOV    XMSError, 0
  550.         RET
  551. UMBReAllocFailed:
  552.     MOV    XMSError, BL
  553.     MOV    AX, DX
  554.     LES    DI, Size
  555.     STOSW
  556.         XOR    AL, AL
  557. end;
  558.  
  559. function XMSErrorMsg(ErrorCode : Byte) : PChar;
  560. var
  561.   I, J : Byte;
  562. begin
  563.   J := 0;
  564.   for I := 1 to XMSErrorCount do
  565.     if XMSErrorNumber[I] = ErrorCode then J := I;
  566.   XMSErrorMsg := XMSErrorString[J];
  567. end;
  568.  
  569. procedure PrintXMSError(const S : string);
  570. begin
  571.   WriteLn(S, ': ', XMSErrorMsg(XMSError));
  572. end;
  573.  
  574. begin
  575.   XMSControl   := @XMSDefaultControl;
  576.   InitXMS;
  577. end.